home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / comm / ums / ums109_1.lha / Tools / TopTen.LHA / TopTen / TopTen.mod < prev   
Text File  |  1993-04-04  |  10KB  |  357 lines
  1. (*-------------------------------------------------------------------------
  2.   :Program.       TopTen
  3.   :Contents.      Scans and analyses UMS message areas
  4.   :Author.        Jan Geißler
  5.   :Address.       fidonet: Jan Geissler@2:2407/106.5
  6.   :Address.       usenet:  jan@digit.stgt.sub.org
  7.   :Address.       phone:   +49 (7142) 44740
  8.   :Address.       snail:   Hermann-Rombach-Str. 17,
  9.   :Address.                D-7120 (74321) Bietigheim-Biss.
  10.   :Author.        Kai Bolay [kai]
  11.   :Address.       Snail Mail:              EMail:
  12.   :Address.       Hoffmannstraße 168       UUCP: kai@amokle.stgt.sub.org
  13.   :Address.       D-71229 Leonberg         FIDO: 2:2407/106.3
  14.   :Copyright.     Public Domain
  15.   :Language.      Oberon-2
  16.   :Translator.    Amiga Oberon V3.01 A+L
  17.   :Usage.         USER/A,PASSWORD/A,GROUP/A
  18.   :History.       v1.1 [jan] 19-Mar-93
  19.   :History.       v1.2 [jan] 21-Mar-93 OddChk disabled while COPYing
  20.   :History.       v2.0 [kai] 31-Mar-93 SINCE, MAXMSG, no VAL()
  21. --------------------------------------------------------------------------- *)
  22.  
  23. MODULE TopTen;
  24.  
  25. (* IMPORT *)
  26. IMPORT d:   Dos,
  27.        s:   SYSTEM,
  28.        NoGuru,
  29.        Break,
  30.        m:   ums,
  31.        u:   Utility,
  32.        str: Strings,
  33.        l:   Lists,
  34.        e:   Exec;
  35.  
  36. CONST copyright = "UMSTopTen 2.0 © Jan Geißler & Kai Bolay, Public Domain.\o$VER: UMSTopTen 2.0 (31.3.93)";
  37.  
  38. (* USAGE/CLI-PARAMS Const/Types/Vars*)
  39. CONST
  40.   template = "USER/A,PASSWORD/A,GROUP/A,SINCE/K/N,MAXMSG/K/N";
  41.   usageErr = "Usage: %s\n%s\n";
  42. TYPE
  43.   LONGPTR = UNTRACED POINTER TO LONGINT;
  44. VAR
  45.   Args: STRUCT
  46.     user, password, group: e.STRPTR;
  47.     since, maxMsg: LONGPTR;
  48.   END;
  49.   RD: d.RDArgsPtr;
  50.  
  51. (* UMS Vars*)
  52. VAR
  53.   msgNum,
  54.   login:    LONGINT;
  55.   msgLen:   LONGINT;
  56.  
  57. (* STATISTIC Consts/Types/Vars *)
  58. CONST
  59.   separator = "---------------------------------------------------------------------------\n";
  60. TYPE
  61.   UserProfile * = RECORD (l.Node)
  62.                     name:     e.STRING;
  63.                     numMsgs:  LONGINT;
  64.                     numBytes: LONGINT;
  65.                   END;
  66.   UserProfilePtr * = POINTER TO UserProfile;
  67.  
  68.   SubjectProfile * = RECORD (l.Node)
  69.                        name:     e.STRING;
  70.                        numMsgs:  LONGINT;
  71.                        numBytes: LONGINT;
  72.                   END;
  73.   SubjectProfilePtr * = POINTER TO SubjectProfile;
  74.  
  75. VAR
  76.   nam:         UserProfilePtr;
  77.   sub:         SubjectProfilePtr;
  78.   from,
  79.   subject:     e.STRING;
  80.  
  81.   UserList:    l.List;
  82.   SubjectList: l.List;
  83.  
  84.   tenUsers:    ARRAY 10 OF UserProfilePtr;
  85.   tenSubjects: ARRAY 10 OF SubjectProfilePtr;
  86.  
  87.   numUsers,
  88.   numSubjects,
  89.   numMsgs,
  90.   numBytes:    LONGINT;
  91.  
  92.   i,c,x:       LONGINT;
  93.  
  94. (* ---------------------------------------------------------------------------------- *)
  95.  
  96. (* PROC:   AddName     - Adds new user and/or increases "byte and message accounts"   *)
  97.  
  98. PROCEDURE AddName;
  99. VAR x,y: LONGINT;
  100.     no:  UserProfilePtr;
  101.     ta:  UserProfilePtr;
  102.     err: BOOLEAN;
  103.     non: l.NodePtr;
  104. BEGIN
  105.    no  := l.Head(UserList)(UserProfilePtr);
  106.    ta  := l.Tail(UserList)(UserProfilePtr);
  107.  
  108.    IF no#NIL THEN
  109.          WHILE (no#NIL) AND (no.name#from) DO
  110.             non := no; IF l.Next(non) THEN END;
  111.             no  := non(UserProfilePtr);
  112.          END;
  113.  
  114.       IF no#NIL THEN
  115.          (* Eintrag gefunden! *)
  116.          INC(no.numBytes,msgLen);
  117.          INC(no.numMsgs);
  118.          RETURN
  119.       END;
  120.    END;
  121.  
  122.    NEW(no);
  123.    COPY(from,no.name);
  124.    no.numBytes := msgLen;
  125.    no.numMsgs  := 1;
  126.    INC(numUsers);
  127.    l.AddTail(UserList,no);
  128. END AddName;
  129.  
  130. (* PROC:   SortUsers   - Sorts the "User Top Ten" by number of messages               *)
  131.  
  132. PROCEDURE SortUsers;
  133. BEGIN
  134.   nam := l.Head(UserList)(UserProfilePtr);
  135.   FOR i := 1 TO numUsers DO
  136.     c := 0;
  137.     LOOP
  138.       IF (tenUsers[c]=NIL) OR ((c=9) AND (tenUsers[9].numMsgs<=nam.numMsgs)) THEN
  139.          tenUsers[c] := nam;
  140.          EXIT;
  141.       ELSE
  142.          IF tenUsers[c].numMsgs<=nam.numMsgs THEN
  143.             FOR x := 0 TO 9-c-1 DO
  144.                 tenUsers[9-x] := tenUsers[9-x-1];
  145.             END;
  146.             tenUsers[c] := nam;
  147.             EXIT;
  148.         END;
  149.       END;
  150.       INC(c); IF c=10 THEN EXIT END;
  151.     END;
  152.   nam := nam.next(UserProfilePtr);
  153.   END;
  154. END SortUsers;
  155.  
  156. (* PROC:   AddSubject  - Adds new subject and/or increases "byte and message account" *)
  157.  
  158. PROCEDURE AddSubject;
  159. VAR x,y: LONGINT;
  160.     no:  SubjectProfilePtr;
  161.     ta:  SubjectProfilePtr;
  162.     err: BOOLEAN;
  163.     non: l.NodePtr;
  164. BEGIN
  165.    no  := l.Head(SubjectList)(SubjectProfilePtr);
  166.    ta  := l.Tail(SubjectList)(SubjectProfilePtr);
  167.  
  168.    IF no#NIL THEN
  169.          WHILE (no#NIL) AND (no.name#subject) DO
  170.             non := no; IF l.Next(non) THEN END;
  171.             no  := non(SubjectProfilePtr);
  172.          END;
  173.  
  174.       IF no#NIL THEN
  175.          (* Eintrag gefunden! *)
  176.          INC(no.numBytes,msgLen);
  177.          INC(no.numMsgs);
  178.          RETURN
  179.       END;
  180.    END;
  181.  
  182.    NEW(no);
  183.    COPY(subject,no.name);
  184.    no.numBytes := msgLen;
  185.    no.numMsgs  := 1;
  186.    INC(numSubjects);
  187.    l.AddTail(SubjectList,no);
  188. END AddSubject;
  189.  
  190. (* PROC:   SortSubject - Sorts the "Subject Top Ten" by number of messages            *)
  191.  
  192. PROCEDURE SortSubjects;
  193. BEGIN
  194.   sub := l.Head(SubjectList)(SubjectProfilePtr);
  195.   FOR i := 1 TO numSubjects DO
  196.     c := 0;
  197.     LOOP
  198.       IF (tenSubjects[c]=NIL) OR ((c=9) AND (tenSubjects[9].numMsgs<=sub.numMsgs)) THEN
  199.          tenSubjects[c] := sub;
  200.          EXIT;
  201.       ELSE
  202.          IF tenSubjects[c].numMsgs<=sub.numMsgs THEN
  203.             FOR x := 0 TO 9-c-1 DO
  204.                 tenSubjects[9-x] := tenSubjects[9-x-1];
  205.             END;
  206.             tenSubjects[c] := sub;
  207.             EXIT;
  208.         END;
  209.       END;
  210.       INC(c); IF c=10 THEN EXIT END;
  211.     END;
  212.   sub := sub.next(SubjectProfilePtr);
  213.   END;
  214. END SortSubjects;
  215.  
  216. (* PROC:   GetArgs     - Gets CLI arguments                                           *)
  217.  
  218. PROCEDURE GetArgs*;
  219. VAR
  220.   c:     INTEGER;
  221.   match: e.STRPTR;
  222. BEGIN
  223.   RD := d.ReadArgs (template,Args,NIL);
  224.   IF RD = NIL THEN d.PrintF (usageErr,s.ADR(copyright),s.ADR(template)); HALT (20) END;
  225.   IF Args.since # NIL THEN d.PrintF ("SINCE not implemented yet.\n"); HALT (20) END;
  226.   IF Args.maxMsg # NIL THEN d.PrintF ("MAXMSG not implemented yet.\n"); HALT (20) END;
  227. END GetArgs;
  228.  
  229. (* PROC:   StripRe     - Strips "RE:" and leading spaces                              *)
  230.  
  231. PROCEDURE StripRe(VAR st:ARRAY OF CHAR);
  232. VAR xy:e.STRING;
  233.     i: LONGINT;
  234. BEGIN
  235.   COPY(st,xy); str.Upper(xy);
  236.   REPEAT
  237.     i := str.Occurs(xy,"RE:");
  238.     IF i#-1 THEN str.Delete(st,i,3); str.Delete(xy,i,3) END;
  239.   UNTIL i=-1;
  240.  
  241.   WHILE (st[0]=" ") DO
  242.     str.Delete(st,0,1);
  243.   END;
  244. END StripRe;
  245.  
  246. (* PROC:   ScanData    - Scans an UMS group                                           *)
  247.  
  248. PROCEDURE ScanData;
  249. VAR
  250.   p1,p2: m.STRPTR;
  251. BEGIN
  252.   d.PrintF("Scanning data...\n");
  253.  
  254.   msgNum := 0;
  255.  
  256.   REPEAT
  257.     msgNum := m.UMSSearchTags(login,m.tagGroup, Args.group,
  258.                                     m.tagSearchLast,msgNum,
  259.                                   (*  m.tagSearchPattern,1 *)
  260.                                     m.tagSearchQuick,1,u.done);
  261.  
  262.     IF msgNum#0 THEN
  263.        IF ~m.ReadUMSMsgTags(login,  m.tagRMsgNum,msgNum,
  264.                                     m.tagRReadHeader,0,
  265.                                     m.tagRFromName,s.ADR(p1),
  266.                                     m.tagRSubject,s.ADR(p2),
  267.                                     m.tagRTxtLength,s.ADR(msgLen),
  268.                                     m.tagRNoUpdate,0,u.done) THEN
  269.           d.PrintF("Cannot open msg!");
  270.        ELSE
  271.           INC(numMsgs); INC(numBytes,msgLen);
  272.           (* $OddChk- *)
  273.           COPY(p2^,subject); StripRe(subject);
  274.           COPY(p1^,from);
  275.           (* $OddChk= *)
  276.  
  277.           AddName;
  278.           AddSubject;
  279.  
  280.           m.FreeUMSMsg(login,msgNum);
  281.        END;
  282.  
  283.     END;
  284.   UNTIL msgNum=0;
  285.  
  286.   d.PrintF("done.\nProcessing data...\n");
  287.  
  288.   SortUsers;
  289.   SortSubjects;
  290.  
  291.   IF (numMsgs=0) THEN c := 0 ELSE c := (numBytes DIV numMsgs) END;
  292.  
  293.   d.PrintF(separator);
  294.   d.PrintF("Area:     %s\n",Args.group);
  295.   d.PrintF("Users:    #%ld\n",numUsers);
  296.   d.PrintF("Messages: #%ld\n",numMsgs);
  297.   d.PrintF("Bytes:    #%ld (av. %ld bytes/message)\n",numBytes,c);
  298.   d.PrintF(separator);
  299.   d.PrintF("TOP 10 - MOST MESSAGES\n");
  300.   d.PrintF(separator);
  301.  
  302.   FOR i := 0 TO 9 DO
  303.          IF tenUsers[i]#NIL THEN
  304.          IF (tenUsers[i].numMsgs=0) THEN c := 0
  305.          ELSE c := tenUsers[i].numBytes DIV tenUsers[i].numMsgs
  306.          END;
  307.  
  308.          IF (tenUsers[i].numMsgs=0) THEN x := 0 ELSE x := (tenUsers[i].numMsgs*100) DIV numMsgs END;
  309.  
  310.          d.PrintF("%2.ld. %-30.28s (%3.ld msgs/%2.ld%%,%8.ld b.,%6.ld b./msg)\n",i+1,s.ADR(tenUsers[i].name),tenUsers[i].numMsgs,x,tenUsers[i].numBytes,c);
  311.       END;
  312.   END;
  313.  
  314.   d.PrintF(separator);
  315.   d.PrintF("TOP 10 - SUBJECTS\n");
  316.   d.PrintF(separator);
  317.   FOR i := 0 TO 9 DO
  318.          IF tenSubjects[i]#NIL THEN
  319.          IF (tenSubjects[i].numMsgs=0) THEN c := 0
  320.          ELSE c := tenSubjects[i].numBytes DIV tenSubjects[i].numMsgs
  321.          END;
  322.  
  323.          IF (tenSubjects[i].numMsgs=0) THEN x := 0 ELSE x := (tenSubjects[i].numMsgs*100) DIV numMsgs END;
  324.  
  325.          d.PrintF("%2.ld. %-30.28s (%3.ld msgs/%2.ld%%,%8.ld b.,%6.ld b./msg)\n",i+1,s.ADR(tenSubjects[i].name),tenSubjects[i].numMsgs,x,tenSubjects[i].numBytes,c);
  326.       END;
  327.   END;
  328.   d.PrintF(separator);
  329.  
  330. END ScanData;
  331.  
  332. (* ---------------------------------------------------------------------------------- *)
  333.  
  334. (* MAIN: *)
  335.  
  336. BEGIN
  337.  
  338.   GetArgs;
  339.   l.Init(SubjectList);
  340.   l.Init(UserList);
  341.  
  342.   (* LOGIN *)
  343.  
  344.   (* $OddChk- *)
  345.   login := m.Login(Args.user^,Args.password^);
  346.   (* $OddChk= *)
  347.   IF login=0 THEN d.PrintF("Login failed.\n"); HALT(20) END;
  348.  
  349.   ScanData;
  350.  
  351. (* CLOSE: *)
  352.  
  353. CLOSE
  354.   IF login # 0 THEN m.Logout(login); login := 0 END;
  355.   IF RD # NIL  THEN d.FreeArgs (RD); RD := NIL  END;
  356. END TopTen.
  357.